#lang racket


(require "../base/main.rkt")

(require "proxy.rkt"
         "session.rkt"
         "shape.rkt")

(provide (struct-out backend)
         make-backend
         backend-evaluate
         backend-evaluate-toplevel
         
         begin-session!
         end-session!)


(struct backend (proxy (sessions #:mutable))
  #:constructor-name new-backend)

(define (make-backend proxy)
  (let ((shapes ((proxy-get-shapes proxy))))
    (new-backend proxy (list (make-session shapes)))))


(define (add-backend-session! backend session)
  (set-backend-sessions! backend (cons session (backend-sessions backend))))

(define (remove-backend-session! backend)
  (begin0
    (first (backend-sessions backend))
    (set-backend-sessions! backend (rest (backend-sessions backend)))))

(define (update-backend-session! backend session)
  (set-backend-sessions! backend (cons session (rest (backend-sessions backend)))))

(define (get-backend-session backend)
  (first (backend-sessions backend)))


(define (add-shape-backend-session! backend shape)
  (let ((session (first (backend-sessions backend))))
    (update-backend-session! backend (add-session session shape))))

(define (evaluate-session-shape! evaluate-fn backend node)
  (let ((exprs ((evaluate-fn (backend-proxy backend)) node)))
    (cond ((shape? exprs)
           (add-shape-backend-session! backend exprs))
          ((list? exprs)
           (map
            (λ (shape)
              (add-shape-backend-session! backend shape))
            (filter-append-tree shape? exprs))))
    exprs))


(define backend-evaluate (cλ evaluate-session-shape! proxy-evaluate))
(define backend-evaluate-toplevel (cλ evaluate-session-shape! proxy-evaluate-toplevel))


(define (begin-session! backend)
  (add-backend-session! backend (first (backend-sessions backend))))

(define (end-session! backend)
  (let ((shapes (session-shapes (remove-backend-session! backend)))
        (previous-shapes (session-shapes (get-backend-session backend)))
        (delete-shape-fn (proxy-delete-shape (backend-proxy backend))))
    (for-each delete-shape-fn (remq* previous-shapes shapes))))